Global

Code
# Load packages
suppressMessages({
 library(dplyr)
 library(ggplot2)
 library(plotly)
 library(glue)
 library(htmltools)
})

# Query GSIDB
get_data <- function(sql) {
con <- DBI::dbConnect(
  drv = RPostgres::Postgres(),
  dbname = Sys.getenv("POSTGRES_DATABASE"),
  host = Sys.getenv("POSTGRES_HOST"),
  port = Sys.getenv("POSTGRES_PORT"),
  user = Sys.getenv("POSTGRES_USER"),
  password = Sys.getenv("POSTGRES_PASSWORD")
)
on.exit(DBI::dbDisconnect(con))
DBI::dbGetQuery(con, sql)
}

# A table with searching and a download button to export as csv
make_table <- function(data, id, name) {
t_id <- glue('{id}_{name}_table')
file <- glue('{id}_{name}.csv')
tagList(
  tags$div(
    style = "display: flex; justify-content: space-between;",
    tags$button(
      class = "btn btn-sm btn-primary rounded-3",
      "Download as CSV",
      onclick = glue("Reactable.downloadDataCSV('{t_id}', '{file}')")
    ),
    tags$input(
      class = "rt-search",
      type = "text",
      placeholder = "Search",
      oninput = glue("Reactable.setSearch('{t_id}', this.value)")
    )
  ),
  reactable::reactable(
    data, 
    searchable = FALSE,
    showPageSizeOptions = TRUE,
    elementId = t_id
  )
)
}

Data By Provider

Code
sql <- "
select
    
    provider,
    analyte as parameter,
    extract(year from sample_date) as year, 
    count(*) as n_measurements
from
    app.bottle
where
    1=1
    
    and analyte = 'Chlorophyll'
group by
    
    extract(year from sample_date), provider, analyte
    
order by
    year, provider
"

data <- get_data(sql)
names(data) <- c(if('Global' != "Global") "Area", "Provider", "Parameter", "Year", "Measurement Count")
if(nrow(data) == 0) {
    cat("No data available")
} else {
 make_table(data, id = "Global_Bottle_Chlorophyll", name = "summary")
} 

Geographical Extent

Code
sql <- "
select
    location_id, 
    loc_desc as description,
    st_x(st_transform(loc_geom, 4326)) as lon, 
    st_y(st_transform(loc_geom, 4326)) as lat,
    COUNT(*) AS record_count 
from
    app.bottle
where
    1=1
    and loc_geom is not null
    
    and analyte = 'Chlorophyll'
GROUP BY 
    location_id, loc_desc, lon, lat
"

data <-get_data(sql) |> 
  mutate(tooltip = glue("Location ID: {location_id}<br>Location Description: {description}<br>Sampe Count: {record_count}"))
if(nrow(data) == 0) {
    cat("No data available")
} else {
  # Plotly doesn't auto center map on data points with R
  center_lon <- mean(data$lon)
  center_lat <- mean(data$lat)
  zoom <- ifelse('Global' == "Global", 6, 8)

  plot_ly(
    data = data,
    lon = ~lon,
    lat = ~lat,
    type = 'scattermapbox',
    mode = "markers",
    marker = list(size = 9, line = list(width = 1, color = "black")),
    hovertext = ~tooltip
  ) |> 
  layout(mapbox = list(
    style = "open-street-map",
    center = list(lon = center_lon, lat = center_lat),
    zoom = zoom
  ))
} 

Timeseries

Code
sql <- "
select
    date_trunc('month', sample_date)::date as sample_date,
    count(*) as n_measurements
from
    app.bottle
where
    1=1
    
    and analyte = 'Chlorophyll'
    and sample_date IS NOT NULL
group by
    date_trunc('month', sample_date)::date
"

data <- get_data(sql)
if(nrow(data) == 0) {
    cat("No data available")
} else {
    plot_ly(data, x = ~sample_date, y = ~n_measurements, type = "bar") |> 
    layout(
        title = "Chlorophyll Measurements by Month",
        xaxis = list(title = "Sample Date"),
        yaxis = list(title = "Number of Measurements", tickformat = ",d")
    )
} 

Depth distribution

Code
sql <- "
select
    upper_depth,
    depth_units
from
    app.bottle
where
    1=1
    and upper_depth is not null
    and depth_units is not null
    
    and analyte = 'Chlorophyll'
"

data <- get_data(sql)
if(nrow(data) == 0) {
    cat("No data available")
} else {
    # Define min and max depth for the x-axis
x_min <- 0     # Minimum depth
x_max <- 350   # Maximum depth

# Create histogram
plot_ly(
  data = data, 
  x = ~upper_depth, 
  type = "histogram",
  xbins = list(
    start = x_min,  # Set bin start
    end = x_max,    # Set bin end
    size = 5        # Bin width of 5 meters
  )
) |> 
  layout(
    title = "Chlorophyll Measurements by Depth",
    xaxis = list(
      title = glue("Depth ({toString(unique(data$depth_units))})"),
      range = c(x_min, x_max)  # Ensure fixed depth range
    ),
    yaxis = list(title = "Number of Measurements", tickformat = ",d")
  )
} 

Heatmap

Code
sql <- "
select
    analyte as parameter,
    extract(year from sample_date) as year,
    extract(month from sample_date) as month,
    count(*) as n_measurements,
    percentile_cont(0.5) within group (order by result) as median,
    string_agg(distinct units, ', ') as units
from
    app.bottle
where
    1=1
    
    and analyte = 'Chlorophyll'
group by
    extract(year from sample_date),
    extract(month from sample_date),
    analyte
    "

# query db
data <- get_data(sql) |>
    filter(!is.na(year), !is.na(month))

if(nrow(data) == 0){
    cat("No data available")
}else{
    data <- data |>
      mutate(
        abb_month = factor(month.abb[month], levels = month.abb),
        median = signif(median, digits = 3),
        tooltip = glue::glue(
      "<b>{abb_month} {year}</b>",
      "<b>Count</b>: {format(n_measurements, big.mark = ',')}",
      "<b>Median</b>: {median} {units}",
      .sep = "<br>",
      .na = "--"
    )
      )

  p <- ggplot(data = data, aes(x = abb_month, y = year, fill = median)) + 
  ggiraph::geom_tile_interactive(aes(tooltip = tooltip), color = "black", width = 1) +
  scale_fill_distiller(
    palette = "Greens",
    direction = 1,
    na.value = "gray90"
  ) +
  #coord_fixed() + # keep tile as square
  scale_x_discrete(
    breaks = month.abb,
    drop = FALSE,
    expand = c(0,0), 
    position = "top"
  ) +
  scale_y_reverse(expand = c(0,0)) +
  labs(y = "Year", fill = paste0("Median Chlorophyll\n(",toString(unique(data$units)),")")) +
  theme_bw() +
  theme(
    axis.title.x=element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    #legend.position = "bottom"
  )
ggiraph::girafe(ggobj = p) 
}

The heatmap data contains samples from all depths and locations in a given area.

Code
if(nrow(data) == 0) {
  cat("No data available")
} else{
  data |>
    select(
      #Area = area_id,
      Year = year,
      Month = abb_month,
      Parameter = parameter,
      Units = units,
      'Measurement Count' = n_measurements,
      Median = median
  ) |>
  make_table(id = "Global_Bottle_Chlorophyll", name = "heatmap")
}

Data By Provider

Code
sql <- "
select
    
    provider,
    analyte as parameter,
    extract(year from sample_date) as year, 
    count(*) as n_measurements
from
    app.bottle
where
    1=1
    
    and analyte = 'ChlorophyllA'
group by
    
    extract(year from sample_date), provider, analyte
    
order by
    year, provider
"

data <- get_data(sql)
names(data) <- c(if('Global' != "Global") "Area", "Provider", "Parameter", "Year", "Measurement Count")
if(nrow(data) == 0) {
    cat("No data available")
} else {
 make_table(data, id = "Global_Bottle_ChlorophyllA", name = "summary")
} 

Geographical Extent

Code
sql <- "
select
    location_id, 
    loc_desc as description,
    st_x(st_transform(loc_geom, 4326)) as lon, 
    st_y(st_transform(loc_geom, 4326)) as lat,
    COUNT(*) AS record_count 
from
    app.bottle
where
    1=1
    and loc_geom is not null
    
    and analyte = 'ChlorophyllA'
GROUP BY 
    location_id, loc_desc, lon, lat
"

data <-get_data(sql) |> 
  mutate(tooltip = glue("Location ID: {location_id}<br>Location Description: {description}<br>Sampe Count: {record_count}"))
if(nrow(data) == 0) {
    cat("No data available")
} else {
  # Plotly doesn't auto center map on data points with R
  center_lon <- mean(data$lon)
  center_lat <- mean(data$lat)
  zoom <- ifelse('Global' == "Global", 6, 8)

  plot_ly(
    data = data,
    lon = ~lon,
    lat = ~lat,
    type = 'scattermapbox',
    mode = "markers",
    marker = list(size = 9, line = list(width = 1, color = "black")),
    hovertext = ~tooltip
  ) |> 
  layout(mapbox = list(
    style = "open-street-map",
    center = list(lon = center_lon, lat = center_lat),
    zoom = zoom
  ))
} 

Timeseries

Code
sql <- "
select
    date_trunc('month', sample_date)::date as sample_date,
    count(*) as n_measurements
from
    app.bottle
where
    1=1
    
    and analyte = 'ChlorophyllA'
    and sample_date IS NOT NULL
group by
    date_trunc('month', sample_date)::date
"

data <- get_data(sql)
if(nrow(data) == 0) {
    cat("No data available")
} else {
    plot_ly(data, x = ~sample_date, y = ~n_measurements, type = "bar") |> 
    layout(
        title = "ChlorophyllA Measurements by Month",
        xaxis = list(title = "Sample Date"),
        yaxis = list(title = "Number of Measurements", tickformat = ",d")
    )
} 

Depth distribution

Code
sql <- "
select
    upper_depth,
    depth_units
from
    app.bottle
where
    1=1
    and upper_depth is not null
    and depth_units is not null
    
    and analyte = 'ChlorophyllA'
"

data <- get_data(sql)
if(nrow(data) == 0) {
    cat("No data available")
} else {
    # Define min and max depth for the x-axis
x_min <- 0     # Minimum depth
x_max <- 350   # Maximum depth

# Create histogram
plot_ly(
  data = data, 
  x = ~upper_depth, 
  type = "histogram",
  xbins = list(
    start = x_min,  # Set bin start
    end = x_max,    # Set bin end
    size = 5        # Bin width of 5 meters
  )
) |> 
  layout(
    title = "ChlorophyllA Measurements by Depth",
    xaxis = list(
      title = glue("Depth ({toString(unique(data$depth_units))})"),
      range = c(x_min, x_max)  # Ensure fixed depth range
    ),
    yaxis = list(title = "Number of Measurements", tickformat = ",d")
  )
} 

Heatmap

Code
sql <- "
select
    analyte as parameter,
    extract(year from sample_date) as year,
    extract(month from sample_date) as month,
    count(*) as n_measurements,
    percentile_cont(0.5) within group (order by result) as median,
    string_agg(distinct units, ', ') as units
from
    app.bottle
where
    1=1
    
    and analyte = 'ChlorophyllA'
group by
    extract(year from sample_date),
    extract(month from sample_date),
    analyte
    "

# query db
data <- get_data(sql) |>
    filter(!is.na(year), !is.na(month))

if(nrow(data) == 0){
    cat("No data available")
}else{
    data <- data |>
      mutate(
        abb_month = factor(month.abb[month], levels = month.abb),
        median = signif(median, digits = 3),
        tooltip = glue::glue(
      "<b>{abb_month} {year}</b>",
      "<b>Count</b>: {format(n_measurements, big.mark = ',')}",
      "<b>Median</b>: {median} {units}",
      .sep = "<br>",
      .na = "--"
    )
      )

  p <- ggplot(data = data, aes(x = abb_month, y = year, fill = median)) + 
  ggiraph::geom_tile_interactive(aes(tooltip = tooltip), color = "black", width = 1) +
  scale_fill_distiller(
    palette = "Greens",
    direction = 1,
    na.value = "gray90"
  ) +
  #coord_fixed() + # keep tile as square
  scale_x_discrete(
    breaks = month.abb,
    drop = FALSE,
    expand = c(0,0), 
    position = "top"
  ) +
  scale_y_reverse(expand = c(0,0)) +
  labs(y = "Year", fill = paste0("Median ChlorophyllA\n(",toString(unique(data$units)),")")) +
  theme_bw() +
  theme(
    axis.title.x=element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    #legend.position = "bottom"
  )
ggiraph::girafe(ggobj = p) 
}

The heatmap data contains samples from all depths and locations in a given area.

Code
if(nrow(data) == 0) {
  cat("No data available")
} else{
  data |>
    select(
      #Area = area_id,
      Year = year,
      Month = abb_month,
      Parameter = parameter,
      Units = units,
      'Measurement Count' = n_measurements,
      Median = median
  ) |>
  make_table(id = "Global_Bottle_ChlorophyllA", name = "heatmap")
}

Data By Provider

Code
sql <- "
select
    
    provider,
    parameter as parameter,
    extract(year from sample_date) as year, 
    count(*) as n_measurements
from
    app.ctd
where
    1=1
    
    and parameter = 'Chlorophyll'
group by
    
    extract(year from sample_date), provider, parameter
    
order by
    year, provider
"

data <- get_data(sql)
names(data) <- c(if('Global' != "Global") "Area", "Provider", "Parameter", "Year", "Measurement Count")
if(nrow(data) == 0) {
    cat("No data available")
} else {
 make_table(data, id = "Global_CTD_Chlorophyll", name = "summary")
} 

Geographical Extent

Code
sql <- "
select
    location_id, 
    loc_desc as description,
    st_x(st_transform(loc_geom, 4326)) as lon, 
    st_y(st_transform(loc_geom, 4326)) as lat,
    COUNT(*) AS record_count 
from
    app.ctd
where
    1=1
    and loc_geom is not null
    
    and parameter = 'Chlorophyll'
GROUP BY 
    location_id, loc_desc, lon, lat
"

data <-get_data(sql) |> 
  mutate(tooltip = glue("Location ID: {location_id}<br>Location Description: {description}<br>Sampe Count: {record_count}"))
if(nrow(data) == 0) {
    cat("No data available")
} else {
  # Plotly doesn't auto center map on data points with R
  center_lon <- mean(data$lon)
  center_lat <- mean(data$lat)
  zoom <- ifelse('Global' == "Global", 6, 8)

  plot_ly(
    data = data,
    lon = ~lon,
    lat = ~lat,
    type = 'scattermapbox',
    mode = "markers",
    marker = list(size = 9, line = list(width = 1, color = "black")),
    hovertext = ~tooltip
  ) |> 
  layout(mapbox = list(
    style = "open-street-map",
    center = list(lon = center_lon, lat = center_lat),
    zoom = zoom
  ))
} 

Timeseries

Code
sql <- "
select
    date_trunc('month', sample_date)::date as sample_date,
    count(*) as n_measurements
from
    app.ctd
where
    1=1
    
    and parameter = 'Chlorophyll'
    and sample_date IS NOT NULL
group by
    date_trunc('month', sample_date)::date
"

data <- get_data(sql)
if(nrow(data) == 0) {
    cat("No data available")
} else {
    plot_ly(data, x = ~sample_date, y = ~n_measurements, type = "bar") |> 
    layout(
        title = "Chlorophyll Measurements by Month",
        xaxis = list(title = "Sample Date"),
        yaxis = list(title = "Number of Measurements", tickformat = ",d")
    )
} 

Depth distribution

Code
sql <- "
select
    upper_depth,
    depth_units
from
    app.ctd
where
    1=1
    and upper_depth is not null
    and depth_units is not null
    
    and parameter = 'Chlorophyll'
"

data <- get_data(sql)
if(nrow(data) == 0) {
    cat("No data available")
} else {
    # Define min and max depth for the x-axis
x_min <- 0     # Minimum depth
x_max <- 350   # Maximum depth

# Create histogram
plot_ly(
  data = data, 
  x = ~upper_depth, 
  type = "histogram",
  xbins = list(
    start = x_min,  # Set bin start
    end = x_max,    # Set bin end
    size = 5        # Bin width of 5 meters
  )
) |> 
  layout(
    title = "Chlorophyll Measurements by Depth",
    xaxis = list(
      title = glue("Depth ({toString(unique(data$depth_units))})"),
      range = c(x_min, x_max)  # Ensure fixed depth range
    ),
    yaxis = list(title = "Number of Measurements", tickformat = ",d")
  )
} 

Heatmap

Code
sql <- "
select
    parameter as parameter,
    extract(year from sample_date) as year,
    extract(month from sample_date) as month,
    count(*) as n_measurements,
    percentile_cont(0.5) within group (order by result) as median,
    string_agg(distinct units, ', ') as units
from
    app.ctd
where
    1=1
    
    and parameter = 'Chlorophyll'
group by
    extract(year from sample_date),
    extract(month from sample_date),
    parameter
    "

# query db
data <- get_data(sql) |>
    filter(!is.na(year), !is.na(month))

if(nrow(data) == 0){
    cat("No data available")
}else{
    data <- data |>
      mutate(
        abb_month = factor(month.abb[month], levels = month.abb),
        median = signif(median, digits = 3),
        tooltip = glue::glue(
      "<b>{abb_month} {year}</b>",
      "<b>Count</b>: {format(n_measurements, big.mark = ',')}",
      "<b>Median</b>: {median} {units}",
      .sep = "<br>",
      .na = "--"
    )
      )

  p <- ggplot(data = data, aes(x = abb_month, y = year, fill = median)) + 
  ggiraph::geom_tile_interactive(aes(tooltip = tooltip), color = "black", width = 1) +
  scale_fill_distiller(
    palette = "Greens",
    direction = 1,
    na.value = "gray90"
  ) +
  #coord_fixed() + # keep tile as square
  scale_x_discrete(
    breaks = month.abb,
    drop = FALSE,
    expand = c(0,0), 
    position = "top"
  ) +
  scale_y_reverse(expand = c(0,0)) +
  labs(y = "Year", fill = paste0("Median Chlorophyll\n(",toString(unique(data$units)),")")) +
  theme_bw() +
  theme(
    axis.title.x=element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    #legend.position = "bottom"
  )
ggiraph::girafe(ggobj = p) 
}

The heatmap data contains samples from all depths and locations in a given area.

Code
if(nrow(data) == 0) {
  cat("No data available")
} else{
  data |>
    select(
      #Area = area_id,
      Year = year,
      Month = abb_month,
      Parameter = parameter,
      Units = units,
      'Measurement Count' = n_measurements,
      Median = median
  ) |>
  make_table(id = "Global_CTD_Chlorophyll", name = "heatmap")
}

Data By Provider

Code
sql <- "
select
    
    provider,
    parameter as parameter,
    extract(year from sample_date) as year, 
    count(*) as n_measurements
from
    app.mooring
where
    1=1
    
    and parameter = 'Chlorophyll'
group by
    
    extract(year from sample_date), provider, parameter
    
order by
    year, provider
"

data <- get_data(sql)
names(data) <- c(if('Global' != "Global") "Area", "Provider", "Parameter", "Year", "Measurement Count")
if(nrow(data) == 0) {
    cat("No data available")
} else {
 make_table(data, id = "Global_Mooring_Chlorophyll", name = "summary")
} 

Geographical Extent

Code
sql <- "
select
    location_id, 
    loc_desc as description,
    st_x(st_transform(loc_geom, 4326)) as lon, 
    st_y(st_transform(loc_geom, 4326)) as lat,
    COUNT(*) AS record_count 
from
    app.mooring
where
    1=1
    and loc_geom is not null
    
    and parameter = 'Chlorophyll'
GROUP BY 
    location_id, loc_desc, lon, lat
"

data <-get_data(sql) |> 
  mutate(tooltip = glue("Location ID: {location_id}<br>Location Description: {description}<br>Sampe Count: {record_count}"))
if(nrow(data) == 0) {
    cat("No data available")
} else {
  # Plotly doesn't auto center map on data points with R
  center_lon <- mean(data$lon)
  center_lat <- mean(data$lat)
  zoom <- ifelse('Global' == "Global", 6, 8)

  plot_ly(
    data = data,
    lon = ~lon,
    lat = ~lat,
    type = 'scattermapbox',
    mode = "markers",
    marker = list(size = 9, line = list(width = 1, color = "black")),
    hovertext = ~tooltip
  ) |> 
  layout(mapbox = list(
    style = "open-street-map",
    center = list(lon = center_lon, lat = center_lat),
    zoom = zoom
  ))
} 

Timeseries

Code
sql <- "
select
    date_trunc('month', sample_date)::date as sample_date,
    count(*) as n_measurements
from
    app.mooring
where
    1=1
    
    and parameter = 'Chlorophyll'
    and sample_date IS NOT NULL
group by
    date_trunc('month', sample_date)::date
"

data <- get_data(sql)
if(nrow(data) == 0) {
    cat("No data available")
} else {
    plot_ly(data, x = ~sample_date, y = ~n_measurements, type = "bar") |> 
    layout(
        title = "Chlorophyll Measurements by Month",
        xaxis = list(title = "Sample Date"),
        yaxis = list(title = "Number of Measurements", tickformat = ",d")
    )
} 

Depth distribution

Code
sql <- "
select
    upper_depth,
    depth_units
from
    app.mooring
where
    1=1
    and upper_depth is not null
    and depth_units is not null
    
    and parameter = 'Chlorophyll'
"

data <- get_data(sql)
if(nrow(data) == 0) {
    cat("No data available")
} else {
    # Define min and max depth for the x-axis
x_min <- 0     # Minimum depth
x_max <- 350   # Maximum depth

# Create histogram
plot_ly(
  data = data, 
  x = ~upper_depth, 
  type = "histogram",
  xbins = list(
    start = x_min,  # Set bin start
    end = x_max,    # Set bin end
    size = 5        # Bin width of 5 meters
  )
) |> 
  layout(
    title = "Chlorophyll Measurements by Depth",
    xaxis = list(
      title = glue("Depth ({toString(unique(data$depth_units))})"),
      range = c(x_min, x_max)  # Ensure fixed depth range
    ),
    yaxis = list(title = "Number of Measurements", tickformat = ",d")
  )
} 

Heatmap

Code
sql <- "
select
    parameter as parameter,
    extract(year from sample_date) as year,
    extract(month from sample_date) as month,
    count(*) as n_measurements,
    percentile_cont(0.5) within group (order by result) as median,
    string_agg(distinct units, ', ') as units
from
    app.mooring
where
    1=1
    
    and parameter = 'Chlorophyll'
group by
    extract(year from sample_date),
    extract(month from sample_date),
    parameter
    "

# query db
data <- get_data(sql) |>
    filter(!is.na(year), !is.na(month))

if(nrow(data) == 0){
    cat("No data available")
}else{
    data <- data |>
      mutate(
        abb_month = factor(month.abb[month], levels = month.abb),
        median = signif(median, digits = 3),
        tooltip = glue::glue(
      "<b>{abb_month} {year}</b>",
      "<b>Count</b>: {format(n_measurements, big.mark = ',')}",
      "<b>Median</b>: {median} {units}",
      .sep = "<br>",
      .na = "--"
    )
      )

  p <- ggplot(data = data, aes(x = abb_month, y = year, fill = median)) + 
  ggiraph::geom_tile_interactive(aes(tooltip = tooltip), color = "black", width = 1) +
  scale_fill_distiller(
    palette = "Greens",
    direction = 1,
    na.value = "gray90"
  ) +
  #coord_fixed() + # keep tile as square
  scale_x_discrete(
    breaks = month.abb,
    drop = FALSE,
    expand = c(0,0), 
    position = "top"
  ) +
  scale_y_reverse(expand = c(0,0)) +
  labs(y = "Year", fill = paste0("Median Chlorophyll\n(",toString(unique(data$units)),")")) +
  theme_bw() +
  theme(
    axis.title.x=element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    #legend.position = "bottom"
  )
ggiraph::girafe(ggobj = p) 
}

The heatmap data contains samples from all depths and locations in a given area.

Code
if(nrow(data) == 0) {
  cat("No data available")
} else{
  data |>
    select(
      #Area = area_id,
      Year = year,
      Month = abb_month,
      Parameter = parameter,
      Units = units,
      'Measurement Count' = n_measurements,
      Median = median
  ) |>
  make_table(id = "Global_Mooring_Chlorophyll", name = "heatmap")
}